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# 1 /usr/bin/perl 
use strict ; 

#Correl__Display__l_6_l .pi 

#De signed to take the CVS formatted exported file from OmniViz and produce a nice PNG 
#image similar to that on the screen in OmniViz 
#New in Version 1.1: 

# Inclusion of clinical data!; 

use GD; 

$|=1; #Do not use output buffer - print cliag immediately 

TrTrTrTh TT tTTT* TT 7TirTrTT*TrTT*Tr TTTt jt jt TtjtJt Jt %t 
TTTT TTTr M iTTT II IT II II 111111 H TTTr TrTr If iriT iriT 

#Global Variable decision area: 

my %Config; #Main Configuration hash, 
my $Top_Color=0 ; 

#my $Block_Size = 10; #The size (in Pixels) of each block. 

#File names: Hard Wired in version 1_11 

#my $Clinical_Data_File = " . /Klinisch_data_AML. csv" ; #The name of the Clinical 
Datafile (Comma delimited format) . 

#my $Output_File - " Output . png » ; #Name of the 

final generated image . 

#Other parameters: 
#my $Block_Lines 
the blocks 

dimensions 
#my $Draw_Key_F 

#my $ Col or_S trips = 40 

#my $Minimum = -1 

#my $Maximum = +1 

#my $ Scale = 5; 
of the Blocks in the Color Stripe 

It it *TT" it TT it it it it it it it it "ft it it *tt tt "ft "ft "ft tt it it 

Kir II II TTTr lr IT TP TTTr Tl I* Tr TT TT TT TT TTTT TTTT TrTT 

Load_Conf iguration () ; #Load configuration from STDIN 

########################Pile acceptance testing######################## 
$Config{Correlation_File} = shift ©ARGV; #Pull filename from ARGV 

$Conf ig{Output_File} = shift ©ARGV; 

if ( ($Config{Correlation_File} eq »«) or I (-e $Conf ig{Correlation_File} ) ) #Check file 
exists (and is not blank!) 

{die "Please enter valid Correlation file name: \n M1 , $Config{Correlation_File} , " 1 
Appears to be invalid\n" ; } 
if ($Config{Output_File} eq "») 

{warn "Output filename not specified: defaulting to 'Output. png' (all previous files 
of same name will be over written) Hit l!!Ctrl-C!I! NOW to avoid\n" ; } 



- "F"; #Whether to draw lines round the (inside) of 
#NB: Reduces colored area by 1 pixel in both 

- "T"; #Should a Key be prepared? 

#The number of intervening colors in the 1 Strip 1 
#Assumed minmum of correlation data. 
#Assumed minmum of correlation data 

#The multiplication factor for relative to $Block_Size 



open IP_FILE, $Conf ig{Correlation_File} or #Open input file or exit with error 

die "Cannot open 1 " , $Conf ig{Correlation_File} , " ' \n for some reason\n" ; 

########################Declare useful variables######################## 

my ©IDs ; #Global - for when we find them. 

my $Row=0; #Need this for later when loading data. 

my $Max_Col=-l; #Used more as a security check than actually in processing, 

my ©Matrix; #Main Matrix loaded. 

my %Patient_ID; #Hash array to store the patient IDs: Usecl to linke the CC & 

Clinical data 

########################Load data from Correlation Matrix f ile######################## 
while (<IP_FILE>) 
{ 

chomp {) ; #Remove end of line char 

$_ — s/[\n\r]//g; 

if ($_ eq "") {next;} #In case there are any blank lines 

unless (/\,/) {die "Errr. There is a distinct lack of commas on this line... of the 
Correlation_File : 1 " , $Conf ig{Correlation_File} , " 1 : \n» " , substr ($_,0,20) ,".... 1 \n" ; } 

my ©Fields = split (",",$_); #Split on Commas (it is a Comma delimited file); 

if (/^Variables/) #Ie . The first line with the "names" of the 

rows/colums . 

{ 

shift ©Fields; #Strip the 'Variables' part off. 
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# print "@Fields\n»; 

©IDs = ©Fields; #Take of copy of the '©Fields' Array which is DLocally 

scoped 

next; #Skip to next line 

} 

my $Patient_ID - shift ©Fields; #strip the 'Patient' part off the front of each 

line . 

# print "D: Loading CC data for patient ID: 1 $Patient_ID ' \n" ; 
$Patient_ID{$Row} = $Patient_ID; 

if ($Patient__ID =~ m/b$/) 

{ 

print "D: Detected ' b' suffix Patient: 1 $Patient_JED ' Corrected to:"; 
$Patient_ID =~ s/b$//; 
print " ' $Patient_ID * \n ,! ; 

} 

if ($#Fields I- $Max_Col) #Check consistent number of Coloums reported 

{ 

if ($Max_Col == -1) 
{ 

$Max_Col - $#Fields; #Wasteful to do this every time., 
print "D: Setting Max_Col to: 1 $Max_Col ' \n" ; 

} 

else 

{ 

print "D: Warning: Number of Coloums Deviation: Row '$Row' (has 
1 $#Fields 1 coloums, previous ones had 1 $Max_Col 1 \n" ; 

} 

} 



foreach my $C__Col (0 . , $#Fields) 

{ 

$Matrix[$Row] [$C_Col] = $Fields [$C_Col] ; 

} 

$Row++ ; 

} 

print "D: Matrix is: [Rows x Coloums] : $Row x $Max_Col\n" ; 

print "D: Or to put it another way: " , $#Matrix, " x 11 , $#{$Matrix [0] } , "\n" ; 

print "D: Matrix Test cell = 0,0 = $Matrix[0] [0] \n D: Matrix Test cell 1,0 = $Matri>c [1] [0] 
D: Matrix Test cell 303,303 = $Matrix[302] [302] \n" f 

print "D: We are using clinical data file: ' $Conf ig{Clinical_Data_File} ' \n" ; 
open CIiIN_FILE, $Conf ig{Clinical_pata_File} or 

die "Cannot open clinical datafile: 1 " , $Conf ig{Clinical_Data_File} , " ' for some 
reason\n" ; 

my $Clinical_Data_Col__HeaderJText_l ; 

my $ C 1 i ni c a l_p at a — Co l_He ade r_T ext_2 ; 

my $Clinical_Data_Col__Header_Text_3 ; 

my $Clinical_Data_Col_Header_Text_4 ; 

my $Clinical_Data_Col_Header_Text_5 ; 

my $Clinical_Data_Col_Header_Text_6 ; 

my $Clinical_Data_Col_Header_Text_7 ; 

my $Clinical_Data_Col_Header_Text_8 ; 

my $Clinical_Data_Col_Header__Text_9 ; 

my $Wanted_Header_Col_Index__l ; 

my $ Want ed_He ade r_Col_Index_2 ; 

my $Wanted_Header_Col_Index_3 ; 

my $Wanted_Header_Col_Index_4 ; 

my $Wanted_Header_Col_Index_5 ; 

my $Wanted_Header_Col_Index_6 ; 

my $ Want ed_He ade r_Col_Index_7 ; 

my $Wanted_ Header_Col__Index_8 ; 

my $Wanted__Header_Col_Index_9 ; 

my %Classif ication_l; 

my %Classif ication_2 ; 

my %Classif ication_3 ; 

my %Classif ication_4 ; 

my %Classif ication_5 ; 

my %Classif ication_6 ; 

my %Classif ication_7 ; 

my %Classif ication 8; 
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my %Classif ication_9 ; 
while (<CLIN_FILE>) 

{ 

chomp ( ) ; #Death to New Line characters I ( ; - ) 

unless (A//) {die "Errr. There is a distinct lack of commas on this line... of the 

Correlation_File: 1 " , $Conf ig{Correlation_File} , » 1 :\n> substr ($_, 0,20) , » ' \n» ; } 

my ©Fields ■ split ( 11 , " , $_J ; 

if ( / ^Volgnummer/ ) #Match the Header line: 

{ 

print »D: t $_ , \n»; 

# @Clinical_JData_Col_Headers « ©Fields; #i.e. just copy the comma-split 

line 

#Run through all column headers to find the index of the one we are looking for: 

foreach my $C_Column (0.. scalar (©Fields)) 

if ($Fields [$C_Column] eq $Conf ig{Header_Col_l} ) #Scan across the 
header line for column we want #1 

{ #Whoppiel Found the one we wanti 

$Wanted_Header_Col_Index_l = $C_Column; 

$Clinical_Data_Col_HeaderJText_l = $Conf ig{Header_Col_l} ; 

#Only now will we add it. 

print "D: Found the Coloumn [1] in the header we are looking 

for! : Index is : 1 $Wanted_Header_Col_Index_l " \n" ; 

next; #There is (we assume) only one unique coloumn name. . . 

if ($Fields t$C_Column] eq $Conf ig{Header_Col_2 } ) #Scan across the 
header line for column we want #2 

{ #whoppiei Found the one we want! 

$Wanted_Header_Col_Index_2 = $C_Column; 

$Clinical_Data_Col_Header_Text_2 = $Conf ig { Header_Col_2 } ; 

#Only now will we add it . 

print "D: Found the Coloumn [2] in the header we are looking 
fori: Index is: ■ $Wanted_Header_Col_Index_2 ' \n" ; 

$Clinical_Data_Col_Header_Text_2 =~ s/,/\./g; #Sometimes 
being Dutch is cute, othertimes its just plain annoying. . .Ja? 

next; #There is (we assume) only one unique coloumn name... 

if ($Fields [$C_Column] eq $Conf ig{Header_Col_3 } ) #Scan across the 
header line for column we want #1 

{ #Whoppiei Found the one we want! 

$Wanted_Header_Col_Index_3 = $C_Column; 

$Clinical_Data_Col_HeaderJText_3 = $Conf ig{Header_Col_3 } ; 
#Only now will we add it . 

print "D : Found the Coloumn [3] in the header we are lookiing 
for! : Index is : 1 $Wanted_Header_Col_jrndex_3 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C_Column] eq $Conf ig{Header_Col_4} ) #Scan across the 
header line for column we want #1 

{ #Whoppie! Found the one we want! 

$Wanted__Header_Col_Index_4 = $C_Column; 

$Clinical_Data_Col_Header_Text_4 = $Conf ig{Header_Col_4} ; 
#Only now will we add it. 

print "D: Found the Coloumn [4] in the header we are lookiing 
for ! : Index is : 1 $Wanted_Header_Col_Index_4 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($ Fields [$C_Column] eq $Conf ig{Header_Col_5 } ) #Scan across the 
header line for column we want #1 

{ #Whoppie ! Found the one we want ! 

$Wanted_Header_Col__Index__5 - $C_Column; 

$Clinical_Data__Col_Header_Text_5 = $Conf ig{Header_Col_5 } ; 
#Only now will we add it . 

print "D: Found the Coloumn [5] in the header we are lookiing 
for! : Index is : 1 $Wanted_Header_Col_Index_5 1 \n'» ; 

next; #There is (we assume) only one unique coloumn name... 

if ($ Fields [$C_Column3 eq $Conf ig{Header_Col_6} ) #Scan across the 
header line for column we want #1 

{ #Whoppie ! Found the one we want ! 

$Wanted_Header_Col_Index_6 = $C_Column; 
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$Clinical_Data_Col_HeaderjText_6 = $Conf ig{Header_Col_6} ; 
#Only now will we add it . 

print "D: Found the Coloumn [6] in the header we are looking 
for I : Index is : ' $Wanted_Header_Col_Index_6 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C__Column] eq $Conf ig{Header_Col_7 } ) #Scan across the 
header line for column we want #7 

{ #Whoppie! Found the one we want I 

$Wanted_Header_Col_Index_7 = $C_Column; 

$Clinical_Data_Col_HeaderJText_7 = $Conf ig{Header_Col_7 } ; 
#Only now will we add it . 

print "D: Found the Coloumn [7] in the header we are looking 
fori : Index is : * $Wanted_Header_Col_ Index_7 ' \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C_Column] eq $Conf ig { Header_Col_8 } ) #Scan across the 
header line for column we want #7 

{ #Whoppiel Found the one we want! 

$Wanted_Header_Col_Index__8 = $C_Column; 

$Clinical_Data_Col_Header_Text_8 = $Conf ig{Header_Col_8 } ; 
#Only now will we add it. 

print "D: Found the Coloumn [8] in the header we are looking 
fori : Index is : 1 $Wanted_Header_Col_Index_8 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C_Column] eq $Conf ig { Header_Col_9 } ) #Scan across the 
header line for column we want #7 

{ #Whoppiei Found the one we want! 

$Wanted_Header__Col_Index_9 = $C_Column; 

$Clinical_Data_Col_Header_Text_9 = $Conf ig{Header_Col_9 } ; 
#Only now will we add it . 

print "D: Found the Coloumn [9] in the header we are looking 
fori : Index is : 1 $Wanted_Header__Col_Index_9 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 



} 

if ($Clinical_Data_Col_Header__Text_l eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
' " , $Conf ig{Header_Col_l} , " ' in the clinical data file: 1 " , $Conf ig{Clinical_Data_File} , " ! \nl 
didn't find it i \nWhat I did find was: * " , join ( " ;», ©Fields) , " 1 if that helps ... \n" ; } 

if ($Clinical_Data_Col_Header_Text_2 eq " " ) #X.e. f nothing was set... 
{die "Opps.\nI was looking for the column header: 
1 " , $Conf ig{Header_Col_2 } , " 1 in the clinical data f ile : 1 " , $Conf ig{Clinical_Data_File} , " 1 \nl 
didn't find itl\nWhat I did find was: ! ",join (»;», ©Fields) , »' if that helps ... \n" ; } 

if ($Clinical_Data_Col__Header_Text_3 eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
1 ■ , $Conf ig{Header_Col_3 } , " 1 in the clinical data f ile : ' 11 , $Conf ig{Clinical_Data_File} , 11 1 \nl 
didn't find itl\nWhat I did find was: 1 ",join (";", ©Fields) r 11 1 if that helps ... \n" ; } 

if ($Clinical_Data_Col_Header_Text__5 eq "") #1.6., nothing was set... 
{die "Opps.\nI was looking for the column header: 
* " , $Conf ig{Header_Col_5} r " ' in the clinical data file : 1 " , $Conf ig{Clinical_Data_File} , " 1 \nl 
didn't find it 1 \nWhat I did find was: 1 ",join (» ; « ,@Fields) , " ' if that helps ... \n» ; } 

if ($Clinical_Data_Col_Header_Text_7 eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
' " , $Conf ig{Header_Col_7} , " ' in the clinical data file : ' " , $Conf ig{Clinical_Data_File} , » ' \nl 
didn't find iti\nWhat I did find was: '",join (";", ©Fields) ' if that helps ... \n" ; } 

if ($Clinical_Data_Col_Header_Text_B eq " " ) #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
1 " , $Config{Header_Col_8} , » ' in the clinical data file: ' " , $Conf ig{Clinical_Data_File} , " 1 \nl 
didn't find it ! \nWhat I did find was: "',join <" ;", ©Fields) , " 1 if that helps ... \n" ; } 

if ($Clinical_Data_Col_Header_Text_9 eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
1 » , $Conf ig{Header_Col_9} , " ' in the clinical data file : ' " , $Conf ig{Clinical_Data_File} , " 1 \nl 
didn't find iti\nWhat I did find was: 1 ",join (»;'», ©Fields) , " ' if that helps ... \n" ; } 
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to next line 



next ; 

} 



#We have found the Coloumn thafc we are looking for... so skip 



# print "D: Loading Clinical Classification for Patient: '$Fields[0]' this 

is: '$Fields [$Wanted_Header_Col_Index_l] ' & : ' $Fields [$Wantea_Header_Col_Index_2] » 
1 $ Fields [ $Wanted_Header_Col_Index_3 ] 1 & : 1 $ Fie Ids [ $Wanted_He .<ader_Col_Index_4 ] 1 & : 
! $Fields[$Wanted_Header_Col_Index_5] 1 \n» ; #The first field contains the 

Patient ID . . . 



header 



# 

# 
t H 



if (exists $Classification{$Fields [$Wanted__Header_Co3__Index] }) 
{#We already have one of these! 

die "Error! Patient IDs are not unique 1 \nThi s one 
$Classification{ $ Fields [$Wanted_Header_Col_Index] } , » 1 foirmd for the 2nd time!" 

} 



$Classif ication_l{$Fields [0] 
$Classif ication_2 { $Fields [0] 
$Classif ication_3 { $Fields [0] 
$Classif ication__4 { $Fields [0] 
$Classif ication_5 { $Fields [0] 
$Classif ication_6 { $Fields [0] 
$Classif ication_7 { $Fields [0] 
$Classif ication_8 {$Fields [0] 



# 

want : 



$Classif ication_9 ($Fields [0] 

push ©Classification, $Fields [$Wanted_Header_Col_Ind<=ix] 
so just add this one 

} 



$ Fie Ids [ $ Want ed_He ade r_Co 1_I ndex__l ; 
$ Fie Ids [ $ Want ed_Heades r_Co 1_I ndex_2 ; 
$ Fie Ids [ $Wanted_Headesr_Col_Index_3 [ 
$Fields [$Wanted_Header_Col__Index_4 ; 
$ Fields [ $Wanted_Header_Col_Index_5 . 
$ Fields [$Wanted_Header_Col_Index_6 ; 
$ Fields [ $Want ed_Header_Col_Index_7 ; 
$ Fields [$Wanted_Heade3r_Col_Index_8 
$ Fields [ $Wanted_HeadeBr_Col_Index__9 

#We know which column we 



########################Prepare colors#####################fr ## 

#$Image -> f illedRectangle ($xl, $yl, $x2+20*$Catergory+$Con_f ig{Block_Size } , $y2 , 
$Block_color) ; 

#This last expression is so that all the bars will fit on I The 800 is a guess! 

my $Width = $Conf ig{Block_Size} * $Row + { $Conf ig{Block_Sis& } + $Conf ig{Graph_Space} * 8) 

my $Height = $Conf ig{Block_Size} * $Max_Col ; 

#Create Image canvases & Allocate basic colors to them: 

my $Image - new GD:: Image ($Width , $Height) ; ^Create main image 'Canvas 1 

my $White = $ Image -> colorAllocate (255,255,255); #Set first color (also background 
color! ) 

Top__Color_Print ( ) ; 

#my $Blue = $Image - > colorAllocate (0,0,255); ^Allocate color 1 Blue 1 ; 

#my $Red = $Image ~ > colorAllocate (255,0,0); ^Allocate color 'Red 1 ; 

my $Black= $Image -> colorAllocate (0,0,0); #Allocat«a color 'Black 1 ; 

Top__Color_Print ( ) ; 

my $Col_Stripe_Width = $Conf ig{Block_Size} * $Config{ Scale) * ($Conf ig{Color_Strips}+l) ; 

my $Col_Stripe_Height = $Conf ig{Block_Size} * $Config{ Scale} ; 

print »D: Color Stripe will be ($Col_StripeJWidth x $Col_Str~ipe_Height ) \n" ; 

my $Color_Stripe_IMG = new GD:: Image ($Col_Stripe_Width, $Col_Stripe_Height) ; 

$Color_Stripe_IMG -> colorAllocate (255,0,255); #Set firsst color (also background 

color ! ) 



my $Title_Bar = new GD: : Image ($Width , 100) ; 

$Title_Bar -> colorAllocate (255,255,255); #Set first colour (also background color!) 
#my $Blue = $Image -> colorAllocate (0,0,255); ^Allocate color 'Blue',- 

#my $Red = $Image -> colorAllocate (255,0,0); #=Allocate color 'Red 1 ; 

$Title_Bar -> colorAllocate (0,0,0); #Allocate color 'Black 1 ; 

my $Patient_IDs - new GD : : Image (4 00, $Height) ; 

$Patient_IDs -> colorAllocate (255 , 255, 255) ; #Set first coloi^r (also background color!) 
#my $Blue = $Image -> colorAllocate (0,0,255); #=Allocate color 'Blue 1 ; 

#my $Red = $Image -> colorAllocate (255,0,0); #=Allocate color ^ed'; 

$Patient_IDs -> colorAllocate (0,0,0); #Allocato color 'Black 1 ; 

#my $Image = new GD: : Image (1000,100); #HW: For testincgr Color Stripe... 

my @Color_Stripe ,* 

#Colors run: Full Blue - Partial Blues - Full White - Partia-1 Reds - Full Red 
print "D: Allocate 'Blues 1 : \n" ; 

foreach my $C_Color (0 . . ($Conf ig{Color_Strips} /2-1) ) #=Run: Full Blue to one level 

below white 

{ 

printf ( » %3i " , $C__Color) ; 
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my $Blue_level = 255/ ($Conf ig{Color_S trips }/2) *$C_Color; #The (complex) 
calculation for the color level 

print "D: Allocating Color: Blue_level = 1 $Blue_level 1 \n» ; #works for the 

red as well but without the "255-" part 

push @Color_Stripe , $Image - > colorAllocate ($Blue_level, $Blue__level , 255) ; 

# $Color_Stripe_IMG -> colorAllocate (255 , $Blue_JLevel , $Blue_level) ; 

Top_Color_Print ( ) ; 

} 

#print "D: $#Color_Stripe, @Color_Stripe\n" ; #Note down, 

the index of the color just allocated in a 'look-up* table 
#print "D: Allocating White: < As mid point >"; 

push @Color_Stripe , $Image -> colorAllocate (255,255,255); #The 'White' is fixed. 
#$Color_Stripe__IMG -> colorAllocate (255,255,255); 
#Top_Color_Print ( ) ; 

#print "D : $#Color_Stripe , ©Color_Stripe\n" ; 
print "\nD: Allocate 'Reds': \n" ; 

foreach my $C_Color (1 . . ($Conf ig{Color_Strips} /2 ) ) #Run: one above 'white' to full red 
{ 

printf ( " %3i " , $C_Color) ; 

my $Red_JLevel = 255 - 255/ ($Conf ig{Color_Strips} /2) *$C_Color ; 
print "D: Red_level = 1 $Red_level 1 \n" ; 

push @Color_Stripe, $Image - > colorAllocate (255 , $Red_level , $Red_level) ; 

# $Color_Stripe_IMG -> colorAllocate (255 , $Red_level , $Red_level) ; 

# Top_Color_Print ( ) ; 

} 

print "\n"; 

ftprint "D : $#Color_Stripe, @Color_Stripe\n" ; 
print "D: Strip Colors - 1 ©Color_Stripe ' \n" ; 

########################Build array image################### 
#Build array 

my $Range=sqrt ( ($Config{ Maximum} - $Config {Minimum} ) ** 2); #Ok, so we know that for 

Pearson CC it will be 2 

my $BINS = $#Color_Stripe +1; 

my $Bin_width= $Range / $BINS; 

print "D: Possible BINS = 1 $BINS 1 ; For Range = ' $ Range 1 , so each bin is: ^Binjwidth' 
wide\n" ; 

print "D: Building Array: \n"; 
print "D: " ; 

foreach my $row ( 0 . . $#Matrix) #Cycle through all rows 

{ 

foreach my $col (0 . . $Max_Col) #Cycle through all coloumsn 

{ 

if ($row == $col) {last;} 

my ( $xl , $x2 , $yl , $y2 , $color) ; #Declare Intermediate variables 

my $ value = $Matrix [$row] [$col] - $Config{ Minimum} ; #Re- center the 

data scale to +ve 

# print 11 D: value = »$value' " ; 

#Calculate the color required using the same indices as lodged @Color_J3tripe (NB: 
Color_Stripe need not exist by this stage: OPTIMISES AWAY?) 

$color = int ($value / $Bin_width) +1 +1; #The extra 1 +1 1 is becaa 

# print "\nD: Matrix Color - $color, \n" ; 

# $bin = int ($value 1) * (1/ $Color_Strips +1) ; 

# print "D: Bin = ' $color 1 \n" ; 

if ( $color >= $BINS) {$color = $BINS;} 

$xl = $Conf ig{Block_Size} * $col; $x2 = $xl + $Conf ig{Block__Size} -1 ; 
#Top left to Bottom right of a square 

$yl = $Conf ig{Block__Si2:e} * $row; $y2 = $yl + $Conf ig{Block__Size} -1 ; 

# die "HIT BLOCK" ; 

# print "D: xl = $xl, x2 = $x2 ; yl = $yl ; y2 = $y2\n" ; 

if ($Patient_ID{$row} eq $Conf ig{Marked_Patient } ) # print "D : value ~ 

1 $ value ' \n" ; 

{$color=$Black; } 

$Image -> filledRect angle ($xl , $yl, $x2 , $y2 , $color) ; #Actually draw 

the square at the correct location 

# $Image -> rectangle ($xl, $yl , $x2- 1 , $y2-l, $Black) ; #Outline the square 

} 

printf ("%5i ",$row); #Just a counter printed to the screen / stream. 

# die "HIT BLOCK\n" ; 

} 
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print " \n" ; 

if ($Config{Block_JLines} eq "T") #Did the user request lines? 

{ 

Draw_Lines__on_Image () ; 

} 

my $Classes; my $Class_Lowest_Color ,* 

if ($Config{MarkJPatientJData} eq "Y") 
{ 

($Class_Lowest_Color, $Classes) = Mark_Patient_Data () ; 

} 

print "D: Classes Returned = ' $Classes'; number of colors needed: 
1 " , $Class_Lowest_Color, 11 1 \n" ; 

#my $Classification_Stripe_IMG « new GD : : Image ($Conf ig{Block_Size} * $Classes * 
$Conf ig{Scale} , $Conf ig{Block_Size} * $Conf ig{Scale} } ; 

####################################### invoke Draw_Key () if necessary 
if ($Config (Draw_Color_ Stripe} eq "T") 

{ 

Draw — Color_S tripe () ; 

} 

#Combine the images and write them out: 

my $Parent_Image = new GD : : Image ($Width + 100, $Height + 200); #Create final 

image 1 Canvas 1 into which others are merged 

my $White = $Parent_Image -> colorAllocate (255,255,255); #Set first color (also 

background color 1 ) 

my $Black = $Parent_Image -> colorAllocate (0,0,0); #Formally allocate color 

'Black' 

my $Patient_ID_Width = 250,* 

$ParentJmage -> copy ($Image, $Patient_ID_Width, 100 , 0, 0, $Width, $Height) ; #Merge the 

main heat-map / Patient Data. 

$Parent_Image -> copy ($Patient_IDs , 0,100, 0,0, $Patient_ID_Width, $Height) ; #Merge the 

Patient IDs 

$Parent_Image -> copy ($ Co 1 or_S t r ip e_IMG, ($ Width - $Col_Stripe_Width) /2 + 
$Patient_ID_Width, $Height + 100 + 100 - $Col_Stripe_Height , 0, 0, $Col_Stripe_Width, 
$Col_Stripe_Height+l) ; 

$Parent_Image -> stringTTF ($Black, " . /f onts/arial . ttf " , 30, 0, 

($Width - $Col_Stripe_Width) /2 + $Patient_IDJWidth - 40, 
$Height + 100 + 40 + ($Conf ig{Block_Size} * $Config{ Scale } ) /2, 
"-1") ; 

$Parent_Image -> stringTTF ($Black, 11 . /f onts/arial . ttf » , 30, 0, 

$Width / 2 + 100 - 10, 

$Height + 100 + 40 + ($Conf ig{Block_Size} * $Config {Scale } ) /2, 
» 0 " ) ; 

$Parent — Image - > stringTTF ($Black, 11 . /f onts/arial . ttf " , 30, 0, 

($Width - $Col_Stripe_Width) /2 + $Patient_ID_Width + 

$Col_Stripe_Width , 

$Height +100+40 + <$Conf ig{Block_Size} * $Config {Scale } ) /2, 
»+l») ; 

my $xl-0; 

$Title_Bar -> stringTTF ($Black, ». /f onts/arial . ttf " , 30, 0, 

$xl, 90, "FAB") ; 
$xl ss $xl +$Conf ig{Graph__Space} ; 

$Title_Bar -> stringTTF ($Black, /f onts/arial . ttf " , 30, 0, 

$xl, 90, "WBC") ; 

$xl = $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF ($Black, ». /f onts/arial . ttf » , 30, 0, 

$xl, 90, "FLT3 ITD" ) ; 

$xl - $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF ($Black, ». /f onts/arial . ttf » , 30, 0/ 

$xl, 90, "OS") ; 

$xl = $xl +$Conf ig{Graph_Space} ; 

$Title__Bar -> stringTTF ($Black, «. /f onts/arial . ttf » , 30, 0> 
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$xl, 90, »EFS»); 
$xl = $xl +$Conf ig{Graph_Space} ; 

$Title_Bar - > stringTTP ($Black, " . /fonts /arial . ttf" , 30, 0, 

$xl, 90, "EVI1") ; 

$xl = $xl +$Conf ig{Graph__Space} ; 

$Title_Bar -> stringTTF ($Black, " . /f onts/arial . ttf " , 30, 0, 

$xl, 90, "CEBP mutant") ; 

$Parent_Image -> copy ($Title_Bar, $Patient_ID_Width, 0, 

0, 0, $Width, 100) ; 

print "Just to remind you: the image created will be : 1 " , $Conf ig{Output_File} , " ' (you can 
alter the default by using 2nd command line argument) \n" ; 

$Parent_Image -> stringTTF ($Black, ». /f onts/arial .ttf M , 50, 3.142 / 2, 

$Width - 100, 
$Height , 

"Orginal Correlation File: 1 $Conf ig{Correlation_File} 1 " ) ; 
$Parent_Image -> stringTTF ($Black, 11 . /f onts/arial .ttf " , 50, 3.142 / 2, 

$Width - 40, 
$Height , 

"This Image is: ' $Conf ig{Output_File} 1 " ) ; 

binmode OUTPUT; 

open OUTPUT, 11 >$Conf ig{Output_File } " or die "Cannot open output file: 1,1 , 
$Conf ig{Output_File} , " 1 \n» ; 

print OUTPUT $Parent_Image -> png () ; #Thankfully OOl The difficult bitl 

close OUTPUT; #Will close anyway upon program exit 



# 
# 
# 
# 
# 

#Subroutines only below here .... 
# 

# ########################### 
#########SUB START 

sub Draw_Lines__on_Image { 

print "D: Ok, You wanted lines .... \n" ; #Guess so.... 

my $x_max = $Conf ig{Block_Size} * $Max__Col; #Pre-calculate the right-hand edge 
m y $y_max m $Conf ig{Block_Sise} * $Row; # Pre -calculate the bottom edge 

print "D: (Horizontal): "; 

foreach my $row (0..$Row) #For all rows 

{ 

my $y = $Conf ig{Block_Size} * $row; #Calculate the 'y ! position 
$Image -> line (0, $y, $x_max, $y, $Black) ; #Draw Horizontal Line 

# printf ("%5i " , $row) ; 

} 

print "\n"; 

print "D: (Vertical): »; 
.foreach my $col ( 0 . . $Max__Col ) #For all coloumns 

{ 

my $x - $Conf ig{Block__Size} * $col; #Calculate the 1 x ' position 
$Image -> line ($x, 0, $x, $y_jnax, $Black) ; #Draw Vertical Line 

# printf { " %5i » , $col ) ; 

} 

print " \n" ; 
} 

#########SUB START 

sub Draw_Color__S tripe { 
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my $White = $Color_Stripe_IMG -> colorAllocate (255,0,255); #Set first color (also 

background color 1 ) 

my $Black = $Color_Stripe_IMG -> colorAllocate (0,0,0); #Allocate color 'Blacks- 

print "D: Color Stripe image is: ' $ColJ3tripe_Width x $Col_Stripe_Heigtit ' \n" ; 
$Color_Stripe_IMG -> rectangle (1,1, $Col_Stripe_Width -1, $Col_Stripe__Height-l, $Black) ; 
#my $lmage = new GD::Image (1000,100); #HW: For testing Color Stripe... 

#my @Color_S tripe ; 

#Colors run: Full Blue - Partial Blues - Full White - Partial Reds - Full Red 
#print "D: Allocate 'Blues': \n" ; 

my @Color_Stripe__Bar ; 

#Colors run: Full Blue - Partial Blues - Full White - Partial Reds - Full Red 
print "D: Allocate 'Blues': \n"; 

foreach my $C_Color (0 . . ($Conf ig{Color_Strips}/2-l) ) #Run: Full Blue to one level 

below white 
{ 

printf (»%3i " , $C_Color) ; 

my $Blue_level = 255/ ($Config{Color_Strips}/2) *$C__Color ; #The (complex) 
calculation for the color level 

# print "D : Allocating Color: Blue_level = » $Blue_level ' \n'» ; #works for the 
red as well but without the "255-" part 

push @Color_Stripe_Bar, $Color_Stripe_IMG -> colorAllocate 
( $Blue_level , $Blue_level ,255) ; 

print "D: Color_Stripe_Bar : , | @Color_Stripe_Bar | i.e. has: $#Color_Stripe_Bar +1 
divisions \n" ; 

#print "D: $#Color_Stripe , @Color_Stripe\n" ; #Note down 

the index of the color just allocated in a 'look-up' table 
#print "D : Allocating White: < As mid point >"; 

push @Color_StripeJ3ar, $Color_Stripe_IMG - > colorAllocate (255,255,255); #The 'White' is 

print "D: Color_Stripe_Bar : , | ®Color_Stripe_Bar | i.e. has: $#Color_Stripe_Bar +1 
divisions\n" ; 

#print "D: $#Color_Stripe, @Color_Stripe\n" ; 
print "\nD: Allocate 'Reds': \n" ; 

foreach my $C_Color (1 . . ($Conf ig{Color_Strips}/2) ) #Run: one above 'wliite' to full red 
{ 

printf ( "%3i " , $C_Color) ; 

my $Red_level a 255 - 255/ ($Conf ig { Col or_St rips} /2) *$C_Color ; 

# print "D : Red_level = ' $Red_level ' \n" ; 

push @Color_Stripe_Bar, $Color_Stripe_IMG ~> colorAllocate 
(255 , $Red_level , $Red_level) ; 

} 

print "\n"; 

print "D: Color_Stripe_Bar : , ] @Color_Stripe_Bar | i.e. has: $#Color_Stripe_Bar +1 
divisions\n" ; 

print "D: Will use color: "; 

foreach my $C_color (0 . . $#Color_Stripe_Bar) 

{ 

printf ( « %3i " , $C_color) ; 

# print "D: Drawing box: 1 $C_color ' \n" ; 

my $X1 = ($C_color) * $Conf ig{Block_Size} * $Config{ Scale } ; #Account for off- 

center scale: 3,4,5.. to 0,1,2 for plotting 

my $X2 = ($C_color +1) * $Conf ig{Block_Size} * $Conf ig{Scale} ; 

# print »D: XI « '$X1', X2 « ' $X2 ' , » ; 

#print "D: Will use color - ' $Color_Stripe [$C_color] ' , i.e. A_color: $A__color; C__color: 
$C_color; 

printf ("%2i " , $C_color) ; 

$ColorjStripe_IMG -> f illedRectangle ($X1, 0 , $X2 , $Conf ig{Block_Size} * 
$Config{ Scale} , $Color_Stripe_Bar [$C_color] ) ; 

$Color_Stripe_IMG -> rectangle ($X1, 0 , $X2-1 / $Conf ig{Block_Size} * 
$Config{ Scale } -1, $Black) ; 

# $Color_Stripe_IMG -> stringTTF ($Black, '' . /f onts/arial . ttf " , 20, 0,$X1, 20, 
$C_color) ; 

} 
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#Highlight the middle part of the scale: 
my $C_color = $#Color_Stripe/2 ; 

my $X1 = $C_color * $Conf ig{Block_Size} ; #Account for off-center scale: 3,4,5.. to 0,1,2 

for plotting 

my $X2 = ($C_color +1) * $Conf ig{Block_Size} ; 

#$Color_Stripe_IMG -> rectangle ($X1 * $Conf ig {Scale} , 1 , $X2 * 
$Config{ Scale} , $Conf ig{Block_Size} * $Conf ig{Scale} -2 , $Black) ; 

#open OUTPUT, ■ >Color_Stripe .png" or die "Cannot open output file: 1 Color^Stripe .png 1 \n" ; 

#print OUTPUT $Color_Stripe_IMG -> png () ; #Thankfully OO! The difficult bit I 

#close OUTPUT; #Will close anyway. . . 

} 

#########SUB START 

#sub Draw_Classif ication_Stripe { 
#HEY 1 This doesn't do anything! I I I 

#open OUTPUT, " >Classif ication_Stripe .png" or die "Cannot open output file: 
1 Class if ication_S tripe .png 1 \n" ; 

#print OUTPUT $Classif ication_Stripe_IMG -> png () ; #Thankfully OO! The difficult 

bit ! 

#close OUTPUT; #Will close anyway. . . 

#} 

#########SUB START 

sub Load_Conf iguration { 

#This loads configuration into the main Config hash array. Defaults are given first: 
$Conf ig{Block_Size} ■ 16; #The size (in Pixels) of each block. 

#File names: Hard Wired in version 1_1 ! 



$Conf ig{Clinical_Data_File} 

23 07 2003 . csv" ; #The name 

$ Config { Output_Fi le } 
final generated image. 
#Other parameters : 
$Config {Block_Lines} 
the blocks 

dimensions 

$Config {Draw_Color_S tripe} 
$Config {Color_S trips} 
1 Strip 1 

$Config {Minimum} 
$ Config {Maximum} 
$Config {Scale} 

to $Block_Size of the Blocks in 
$Conf ig{Correlation_File} 

View all clustered columnsets 
$Conf ig{Correlation_File} 
$ Config { Header_Col_l } 
$Conf ig{Header_Col_2 } 
$Conf ig{Header_Col_3 } 
#$Conf ig{Header_Col_4 } 
$Conf ig{Header_Col__5 } 
$Conf ig{Header_Col — 6 } 
$Conf ig{Header_ Col_7 } 
$Conf ig{Header_Col_8 } 
$Conf ig{Header_Col_9 } 



= " . /csv/Tabel AML clinical and molecuDLar data 
of the Clinical Datafile (Comma delimited format) . 

= "4850utput .png" ; #3STame of the 



= "F" ; #Whether to draw lines round ttie (inside) of 

#NB: Reduces colored area by 1 pixel in both 

= " T " ; # should a Key be prepared? 
= 40; #The number of intervening colors in the 

= -1; #Assumed minmum of correlation data 

= +1; #Assumed minmum of correlation data 

= 5; #The multiplication factor for relative 

the Color Stripe 

= »./362 

. CSV" ; 

- n » / incoming/ 485genes . csv" ; 
= "FAB"; 

= "WBC" ; 

= "FLT3 ITD" ,* 

= "FLT3 TKD"; 

= "OS"; 

= "efs"; 

= "EVI1"; 

- "CEBP mutant"; 
= "osi"; 



$Conf ig{Mark_Nulls} = "SPOT"; 

$Conf ig{Mark_J?atient_Data} = "Y" ; 

$Conf ig{Marked_Patient} = "XXXXXXXXXXXXXXXXX" ; # Inserts a black 

line to demonstrated correspondence / registery between patient CC and classification type. 

$Config{Label_Classes} = "Y» ; 
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$Config{Second_Scale_Spacing} = $Conf ig{Block_Size} * 10; #The spacing between the 

first and the second scale... *10 sets this to -130% the length of the first scale 

$Conf ig{Low_Blood_Count} = 100; #These were set by MJM because they were "nice 
round numbers" they have no scientific justification 

$Conf ig{Med_Blood_Count} = 150; # 

$Config{Hi_Blood_Count} =200; # 

$Conf ig { Blood_Count_Max } =300; # 

$Conf ig{EFS_Max} =166 

$Conf ig{OS_Max} = 166 

$Conf ig { Graph_Space } = 250 

$Conf ig{Font_Size} = 15; 

#print "D: Reading Configuration Information from STDINT : \n" ; 
#my $Keys_Read=0 ; 
#my @STDIN= <STDIN>; 
#if ($STDIN[0] eq "") {return;} 
#foreach (OSTDIN) 

# { 

# chomp () ; 

# unless (/=/) {die "Error reading cofiguration file: Pattern expected 
is : \n 1 Parameter = Value 1 \nWhat was found was : 1 $_' \n" ; } 

# s/ //g; #Kill all spaces 

# (my $Key , my $Value) = split (»=",$_); 

# print "D: Key = »$Key' ; Value = ! $Value'\n"; 

# $Keys_Read ++; 

# } 

#print "D: Finished reading config file: In total ' $Key-s_Read 1 extra parameters read\n" ; 

} 

#########SUB START 

sub Mark_Patient_Data { 

#Find number of Colors needed {i.e. find number of catergories : 

my $Black = $ Image -> colorAllocate (0,0,0); 

my $Yellow = $Image -> colorAllocate (255,255,0); #M6 

my $Cyan = $Image -> colorAllocate (0,255,255) ; #M5 

my $Maroon = $ Image -> colorAllocate (176,48,96); #M4 

my $Orange = $Image -> colorAllocate (255,165,0); #M3 

my $Pink - $Image -> colorAllocate (255,105,180); #M2 

my $D_Green - $lmage -> colorAllocate (85,107,47); #M1 

my $Green = $Image -> colorAllocate (0,255,0); #M0 

my $Red = $Image -> colorAllocate (255,0,0); 

my $Soft_Green = $Image -> colorAllocate (128,255,128); 

my $Soft_Red = $Image -> colorAllocate (255,128, 128); 

my $Low=$Image -> colorAllocate (32,32,32); #12.5% Grey: Low Blood Cell count 

my $Med=$Image ~> colorAllocate (128,128,128); #50% Grey: Medium Blood Cell count 

my $Hi =$Image -> colorAllocate (214,214,214); #87.5% Grey: High Blood Cell count 

foreach my $row (0 . . $#Matrix) #Cycle through all rows 

{ 

my ($xl, $yl, $x2, $y2) ; #$row; my $Y = $row; 

$xl = $Config{Block_Size} * $row; $x2 = $xl + $Conf ig{Block_Size} ; #Top left to 
Bottom right of a square 

$yl = $xl; $y2 = $yl + $Conf ig{Block_Size} -1 ; 

#This is the diagonals of the square. . . . 

my $x_cent » int ( ($x2 - $xl ) /2) + $xl; my $y_cent » int ( ($y2 - $yl ) /2) + 
$yl; #The center might be useful ... calculation is over complex, but hey - it's standard! 

my $C_Class « $Classif ication__l{ $Patient_ID{ $row} } ; #Just a convenience 

really. . . . 

print "D: Classification of Patient ($Patient_ID{ $row} ) #'$row» = 1 $C_Class 1 \n" ; 
$Image -> f illedRectangle ($xl, $yl, $x2, $y2, $White) ; #Blank blocks on 

diagongal 

#print "D: $#Color_Stripe , @Color_Stripe\n" ; #Note down 

the index of the color just allocated in a 'look-up' table 
#print "D: Allocating White: < As mid point >"; 



#Ok! This is where the logic begins... 
#Do classification #1: FAB Type: 
if <$C_Class =~ m/Mx/) 

{ #Ie . A mixed system. . . 

#Draw Spot .... 

print "D: Mixed classification found - drawing spot\n» ; 
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# $Image -> line ($xl, $yl, $x2 , $y2 , $Black) ; 

$Image -> arc ($x_cent , $y__cent , $Conf ig{Block__Size} , $Conf ig{Block_Size} , 0 

,360 , $Black) ; 

$Image -> fill ( $x_cent , $y_cent , $Black) ; 

print "D: Diagonal block runs: $xl, $yl through center at $x_cent l $y__cent 
to: $x2, $y2\n"; 

} 

if ($C_Class eq ««) 

{ #Ie. Missing Classification... 

print "D: Missing Classification: Drawing a cross\n" ; 
$Image -> line ($xl, $yl, $x2 , $y2, $Black) ; 
$Image - > line {$x2, $yl/ $xl, $y2, $Black> ; 

# next ; #Easy eh? ( ; - ) 

} 

if ($C_Class =~ m/M/ and not $C_Class =- m/Mx/) 

{ 

my $Block_color; 

my $Catergory = substr ($C_Class, 1,1); 
print "D: Catergory = 1 $Catergory * \n" ; 

# $Block_color - $Cat_bottom_color + $Catergory~; 

if ($Catergory == 6) { $Block_color - $Yellow; } 
if ($Catergory =- 5) { $Block_color = $Cyan;} 
if ($Catergory == 4) { $Block_color = $Maroori;} 
if ($Catergory == 3) { $Block_color = $Orange ; } 
if ($Catergory == 2) {$Block_color = $Pink;} 

if ( $ Catergory — 1) { $Block_color = $D_Green; } 

if ($Catergory == 0) { $Block_color - $Green; } 

print "D: Will use color: 1 $Block_color 1 \n u ; 

$x2 = $xl + 2 0*$Catergory+$Conf ig{Block_Size} -1; 

$Image -> f illedRectangle ($xl, $yl, $x2 , $y-2 , $Block_color) ; 

if ($Config{Label_Classes} eq »Y») 

{ 

$Image -> stringTTF ($Black, /fonts /Courier . ttf" , 15, 0, $x2+10, 

$y2, $Catergory) ; 

} 

$Patient_IDs -> stringTTF ($Black, 11 . /fonts /Courier . ttf" , $Conf ig{Font_Size} , 0, 1, 
$y2 , $ Pat i ent_ID { $ row } ) ; 

if ($Patient_ID{$row} eq $Conf ig{Marked_Patient } ) #This is used to check 

the 'register 1 between the CC data and the Patient Classification. 

{ 

# my $Block_color = $Black; 

my $Catergory = substr ($C_Class, 1,1); 

print "D: Marking Patient: ' $Patient_ID{$row} 1 using color: BLACK\n"; 
my $ Catergory = 10 ,- 

$Image -> f illedRectangle ($xl, $yl, $x2 + 20 * $Catergory, $y2 , $Black) ; 

} 

#Now something similar for classification #2 (Blood Cell Count) : 

$xl=$xl + $Conf ig{Graph__Space} ; #ie. give some space between the two scales 

$x2 = $xl + $Conf ig{Block__Size} ; 

my $Blood_Count - $Classif ication__2 {$Patient_ID{$row } } ; 
print "D: Blood count - ' $Blood_Count • \n" ; 
if ($Blood_Count == undef) 

{ 

print "D: Missing Blood Count Classification: Drawing a cross\n" ; 
$lmage -> line ($xl, $yl, $x2, $y2, $Black) ; 
$Image -> line ($x2, $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

my $Bar_Length = $Blood_Count / $Conf ig{Blooc\_Count_Max} * 20 0; 
Draw_blood_bar ($Med, $Blood_Count , $xl, $yl, $Bar_Length) ; 

} 

# $ Conf ig { Bl ood_Count_Max } 

#Now something similar for classification #3 (FLT ITD) : 

$xl=$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 
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my $FLT__Class = $Classif ication_3 {$Patient_ID{ $row} } ; 

print M D : FLT3 Class = ' $FLT_Class l for Patient: « $Patient_ID{ $row} ' \n" ; 
if ($FLT_Class eq " " ) 

{ 

print "D: Missing FTL Classification: Drawing a cross\n" ; 

$x2 = $xl + $Conf ig{Block_Size} ; 

$Image - > line ($xl, $yl, $x2 , $y2, $Black) ; 

$Image -> line ($x2, $yl, $xl, $y2 , $Black) ; 

} 

else 
{ 

if ($FLT_Class =~ m/Pos/i or $FLT_Class =~ m/Yes/i) 
{ 

$x2=$xl + 150; 

$Image -> filledRect angle ($xl, $yl, $x2, $y2, $Soft_Red) ; 
$Image -> stringTTF ($Black, ". /fonts /Courier . ttf" , 
$ Conf ig { Font_S i z e } , 0, $x2+10, $y2-2, "Pos") ; 

} 

else 

{ 

$x2=$xl + 75; 

$Image -> filledRect angle ($xl, $yl, $x2, $y2 , $Sof t^Green) ; 

$Image -> stringTTF ($Black, " . /fonts /Courier . ttf " , 
$Conf ig{Font_Size} , 0, $x2+10, $y2-3, "Neg"),- 

} 

} 



#Now something similar for classification #5 (OS) : 

$xl=$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 

$x2 = $xl + $Conf ig{Block_Size} ; 

my $OS = $Classif ication_5{$Patient_ID{$row} } ; 

print »D: OS - ' $OS»\n"; 

if ($0S eg »") 

{ 

print "D: Missing OS Classification: Drawing a cross\n" ; 
$Image -> line ($xl, $yl, $x2, $y2 , $Black) ; 
$Image -> line <$x2, $yl, $xl, $y2, $Black) ; 

} 

else 
{ 

my $Bar_Length = $OS / $Conf ig {OS_Max} * 200; 
Draw_blood_bar ($Med, $OS,$xl, $yl , $Bar_Length) ; 

} 

# $ Conf ig { Blood_Count_Max } 

#Now something similar for classification #6 (EFS) : 

$xl=$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 

$x2 = $xl + $Conf ig{Block_Sise} ; 

my $EFS = $Classif ication_6 { $Patient_ID{ $row} } ; 

print "D: $Patient_ID{ $row} EFS m ' $EFS • \n" ; 

if ($EFS eq »») 

{ 

print "D: Missing EFS Classification: Drawing a cross\n" ; 
$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
$Image -> line ($x2, $yl, $xl, $y2 , $Black) ; 

} 

else 

{ 

print "D: Testing Dead/ alive status: 
1 " , $Classif ication_9 { $Patient_ID{ $row} } , » ' \n" ; 

my $Bar_Length « $EFS / $Conf ig{EFS_Max} * 200; 

if ($Classification_9{$Patienfc_ID{$row}} eq "alive") 

{Draw_blood_bar ($Sof t_Green, $EFS,$xl, $yl, $Bar_Length) ; } 
else 

{DrawJblood_bar ($Soft_Red, $EFS,$xl, $yl, $Bar_Length) ; } 

} 
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#Now something similar for classification #7 (EVI1) : 

$xl=$xl + $Conf ig{Graph_Spa.ce} ; #ie . give some space between the two scales 

my $EVIl_Class = $Classif ication__7{$Patient_ID{$row} } ; 

print "D: EVI1 Class = 1 $EVIl_Class ' for Patient: • $Patient_ID{ $row} ' \n» ; 
if ($EVIl_Class eq »») 

{ 

print "D: Missing EVI1 Classification: Drawing a cross\n" ; 

$x2 = $xl + $Conf ig{Block_Size} ; 

$ Image -> line ($xl, $yl, $x2, $y2, $Black) ; 

$Image -> line ($x2 , $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

if ($EVIl_Class =~ m/Pos/i or $EVIl_Class =- m/Yes/i) 
{ 

$x2-$xl + 150; 

$Image -> filledRec tangle ($xl f $yl, $x2 , $y2 , $Soft_Red) ; 
$Image -> stringTTF ($Black, ". /fonts /Courier . ttf" , 
$Conf ig{Font_Size} , 0, $x2+10, $y2 - 2 , "Pos") ? 

} 

else 

{ 

$x2 = $xl + 75; 

$Image -> f illedRectangle ($xl, $yl, $x2 , $y2 , $Sof t^Green) ; 

$Image -> stringTTF ($Black, " . /fonts/Courier .ttf 11 , 
$Conf ig{Font_Size} , 0, $x2+10, $y2-3, "Neg"); 

} 

} 

#CEBP mutant to go inl 

#Now something similar for classification #8 (CEBP) : 

$xl=$xl + $Conf ig{Graph_Spa.ce} ; #ie . give some space between the two scales 

my $CEBP_Class = $Classif ication_8 { $Patient_ID{ $row} } ; 

print 11 D : CEBP Class = ! $CEBP_Class ! for Patient: 1 $Patient_ID{$row} 1 \n" ; 
if ($CEBP_Class eq »") 

{ 

print "D: Missing CEBP Classification: Drawing a cross\n" ; 

$x2 a $xl + $Conf ±g;{Block__Size} ; 

$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 

$Image - > line ($x2, $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

if ($CEBP_Class =~ m/Pos/i or $CEBP_Class =~ m/Yes/i) 

{ 

$x2=$xl + 15 0; 

$Image -> f IlledRectangle ($xl, $yl, $x2 , $y2 , $Sof t_Red) ; 
$Image -> stringTTF ($Black, ". /fonts/Courier . ttf " , 
$Conf ig{Font_Size} , 0, $x2+10, $y2-2, "Pos"); 

} 

else 

{ 

$x2 = $xl + 75; 

$ Image -> f illedRectangle ($xl, $yl, $x2 , $y2 , $Soft_Green) ; 

$Image -> stringTTF {$Black, " . / fonts/Courier . ttf 11 , 
$Conf ig{Font_Sise} , 0, $x2+10, $y2-3, "Neg"); 

} 

} 

next ; 

} 

#return ( $Cat_bottom_color , $Number_of _colors) ; 

} 

sub Draw_blood_bar { 

(my $color / my $Count / my $x, my $y, my $Length) = @_; 

$Image -> f illedRectangle ($x, $y, $x + "~ 1 ' " ' r ~~ ' Sxze}-1, $color) ; 
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$Image -> stringTTF (1, ». /fonts/Courier . ttf" , $Conf ig{Font_Sise} , 0, $x + $Length + 10 f $y 
+ $Conf ig{Block_Size} -1, int ($ Count) ) ; 

} 

################START SUB 

#sub Draw_Classif i c at ion_S tripe { 

#Er? Finishing this would be a good idea. . . . 

#Heyl This doesn't do anything I 

#for my $C_Class (1. . $Classes) 

# { 



# } 
#} 



sub Label_Class { 

(my $x, my $y, my $Cat) = 

print »D: LABEL_CLASS : Got the data: [X,Y,Cat] '$x' , ' $y'/ 1 $Cat ' passed\n" ; 
} 

sub Top_Color_Print { 

print "D: [Allocating new color of index: ' $Top_Color 1 ] \n" ; 

$Top_Color ++ ; 

} 

sub Allocate_Catergory__range { 
my %C1 asses ; 

my $Number_of__Glasses==0 ; 

foreach my $C_Patient (keys %Class±f ication_l) #Cycle through all 

classifications 

{ 

# print "D: Classification of Patient: 1 $C_Patient 1 - 
1 $Classification_l{$C_Patient} '\n» 

unless (exists $Classes{ $Classif ication_l { $C_Patient } } ) #Check whether this 
classification has been seen before. 

{ #Ok, it hasn't: 

print "D: Found new Class: 1 $Classif ication_l{ $C_Patient } 1 \n" ,- 
$Classes{$Classif ication_l{$C_Patient} } - $Classif ication_l{$C_Patient} ; 
#Add it to the Hash Array 

$Number_of_Classes #Add 1 to the tally of classes 

} 

print "D: Number of FAB Classes (patient catergories) = 1 $Number_of,_Classes 1 \n" ; #Usef ul to 
know 

print "D: Allocate 'Catergory Colors': \n" ; 

my $CC_max_color = $#Color_Stripe ; 

my $Cat_bottom_color = $CC__max_color + 3; 

print "D: Last Color Allocated for- CC Matrix: $CC_max_color ' $Cat_bottom_color ' \n" ; 
my $Number_of_colors = $Number_pf__Cl asses - 3; 

foreach my $C_Color (0 . . $Number_of_colors) #Ie, pickup where the CC data left off 
{ 

printf (»%3i " , $C_Color) ; 

my $Red_JLevel = int (255 / $Number_of _colors * $C_Color) ; #The (complex) 
calculation for the color level 

print "D: For $C__Color: Reol_JLevel (needed to alter Green to Yellow) = 1 $Red_JLevel ' , 
i.e. Color : " , ($C_Color+$Cat_bottom_color) , "\n» ; #works for the red as well but 

without the "255-" part 

# push @Color_Stripe, 

$Image -> colorAllocate ($Red__level , 255 , 0) ; 

} 

my $Cat_top_color = $#Color_Stripe ; #Don't think this is actually used. . .nice to 

know though! 

print "D: Catergory colors will range from: $Cat_bottom_color to ' 11 , $Cat_bottom_color + 
$Number_pf _colors , " ' \n" ; 

} 
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